Classifying Brand Preference
Rhys Hewer
1 Executive Summary
REMEMBER!! Combine the data sets at the end!
1.1 Objective
1.2 Method
1.3 Findings
1.4 Recommendations
2 Initial Data Processing
#load libraries
library(readxl)
library(dplyr)
library(ggplot2)
library(plotly)
library(RColorBrewer)
library(corrplot)
library(caret)
library(tidyr)
library(kableExtra)
library(parallel)
library(doParallel)
library(rattle)
library(rpart)#read in data
setwd("C:/Users/rhysh/Google Drive/Data Science/Ubiqum/Project 2/Task 2")
incomplete <- read.csv("SurveyIncomplete.csv")
origdata <- read_xlsx("Survey_Key_and_Complete_Responses_excel.xlsx", sheet = 2)
data <- origdataAs we are working across 2 spreadsheets it is important to check to see if they are structured alike or whether manipulation will be required to ensure they have the same features.
#Check structure of data to see if alike
names(incomplete) == names(data)## [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUEThe features match between the spreadsheets so no data manipulation is needed in that respect.
incomplete %>% sample_n(5)## salary age elevel car zipcode credit brand
## 2203 42484.81 53 2 17 0 267312.8 0
## 3744 66027.90 51 1 19 6 85339.6 0
## 982 40472.56 75 0 6 0 198786.7 0
## 3186 94875.12 39 3 11 6 157076.7 0
## 3379 113373.87 65 4 17 2 500000.0 0data %>% sample_n(5) ## # A tibble: 5 x 7
## salary age elevel car zipcode credit brand
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 115894. 23 4 4 2 257552. 1
## 2 129379. 45 2 1 7 20326. 1
## 3 90345. 31 4 2 6 465250. 0
## 4 137827. 48 2 5 5 420642. 1
## 5 103365. 27 2 20 0 414986. 1A quick look at a sample from both spreadsheets shows that they are very similar in composition.
str(incomplete)## 'data.frame': 5000 obs. of 7 variables:
## $ salary : num 110500 140894 119160 20000 93956 ...
## $ age : int 54 44 49 56 59 71 32 33 32 58 ...
## $ elevel : int 3 4 2 0 1 2 1 4 1 2 ...
## $ car : int 15 20 1 9 15 7 17 17 19 8 ...
## $ zipcode: int 4 7 3 1 1 2 1 0 2 4 ...
## $ credit : num 354724 395015 122025 99630 458680 ...
## $ brand : int 0 0 0 0 0 0 0 0 0 0 ...str(data)## Classes 'tbl_df', 'tbl' and 'data.frame': 10000 obs. of 7 variables:
## $ salary : num 119807 106880 78021 63690 50874 ...
## $ age : num 45 63 23 51 20 56 24 62 29 41 ...
## $ elevel : num 0 1 0 3 3 3 4 3 4 1 ...
## $ car : num 14 11 15 6 14 14 8 3 17 5 ...
## $ zipcode: num 4 6 2 5 4 3 5 0 0 4 ...
## $ credit : num 442038 45007 48795 40889 352951 ...
## $ brand : num 0 1 0 1 0 1 1 1 0 1 ...Looking at the structure shows that a few changes are needed in respect of the data types.
Overall, however, the datasets are sufficiently similar. I will take the strategy of splitting into training, test and final prediction sets. The training and testing sets will come from the complete responses data. Final prediction from the incomplete responses.
The exploratory data analysis will be performed on the complete data but any data transformations taking place on the training/testing sets will also need to be made on the Final prediction data prior to modelling this.
#check for NAs
data %>% is.na() %>% sum()## [1] 0incomplete %>% is.na() %>% sum()## [1] 0There are no missing values in either data set.
#data types
data$elevel <- data$elevel %>% as.factor()
data$car <- data$car %>% as.factor()
data$zipcode <- data$zipcode %>% as.factor()
data$brand <- data$brand %>% as.factor()Education level, car owned, zip code and brand preference are converted from numeric to factors.
##check for outliers
numericVars <- Filter(is.numeric, data)
outliers <- numericVars %>% sapply(function(x) boxplot(x, plot=FALSE)$out) %>% str()## List of 3
## $ salary: num(0)
## $ age : num(0)
## $ credit: num(0)There are no outliers.
3 Exploratory Data Analysis
3.1 Feature Histograms
3.1.1 Brand Preference Histogram
#EDA
##Key feature is brand preference, begin with exploring this value.
g6 <- ggplot(data, aes(brand, fill = brand)) +
geom_bar() +
theme_bw() +
scale_fill_brewer(palette="Dark2") +
xlab("Brand Preference") +
ylab("Frequency") +
ggtitle("Brand Preference Frequencies")
g6
- We see a clear preference for brand 1 over brand 0.
3.1.2 Histogram of other variables
##review other histograms for skewdness
histData <- origdata %>% select(-brand)
g8 <- ggplot(gather(histData), aes(value)) +
geom_histogram(bins = 10, fill = "#D95F02", colour = "white") +
theme_bw() +
facet_wrap(~key, scales = 'free_x') +
xlab("Value") +
ylab("Count") +
ggtitle("Histograms of Numeric Variables")
g8
- Across the remaining features we see no extreme skewing or noteworthy patterns.
3.2 Brand Choice Plotting
3.2.1 Brand Choice v Salary
## Plot Brand choice v other variables
g1 <- ggplot(data, aes(brand, salary, fill = brand)) +
geom_violin() +
theme_bw() +
scale_fill_brewer(palette="Dark2") +
xlab("Brand Preference") +
ylab("Salary ($)") +
ggtitle("Brand Preference v Salary")
g1 <- ggplotly(g1)
g1- There is a clear pattern: salaries ranging between 45k - 100k seem to have a preference for brand 0. Salaries outside of this range seem to have a preference for brand 1.
3.2.2 Brand Choice v Age
g2 <- ggplot(data, aes(brand, age, fill = brand)) +
geom_violin() +
theme_bw() +
scale_fill_brewer(palette="Dark2") +
xlab("Brand Preference") +
ylab("Age") +
ggtitle("Brand Preference v Age")
g2 <- ggplotly(g2)
g2- There is no noteworthy pattern between brand preference and age.
3.2.3 Brand Choice v Education Level
g3 <- ggplot(data, aes(brand, elevel, colour = brand)) +
geom_count() +
theme_bw() +
scale_color_brewer(palette="Dark2") +
xlab("Brand Preference") +
ylab("Education Level") +
ggtitle("Brand Preference v Education Level")
g3
- The general preference for brand 1 is shown in this plot but there also seems to be a consistent preference for brand 1 regardless of education level whereas there seems to be more variation within preference for brand 0 based on the education level.
3.2.4 Brand Choice v Car
g4 <- ggplot(data, aes(brand, car, colour = brand)) +
geom_count() +
theme_bw() +
scale_color_brewer(palette="Dark2") +
xlab("Brand Preference") +
ylab("Car") +
ggtitle("Brand Preference v Car")
g4
- The general preference for brand 1 is shown in this plot but there also seems to be a consistent preference for brand 1 regardless of car whereas there seems to be more variation within preference for brand 0 based on the car owned.
3.2.5 Brand Choice v Zip Code
g5 <- ggplot(data, aes(brand, zipcode, colour = brand)) +
geom_count() +
theme_bw() +
scale_color_brewer(palette="Dark2") +
xlab("Brand Preference") +
ylab("Zip Code") +
ggtitle("Brand Preference v Zip Code")
g5
- The general preference for brand 1 is shown in this plot but there also seems to be a consistent preference for brand 1 regardless of zip code whereas there seems to be more variation within preference for brand 0 based on the car owned.
3.2.6 Brand Choice v Credit
g7 <- ggplot(data, aes(brand, credit, fill = brand)) +
geom_violin() +
theme_bw() +
scale_fill_brewer(palette="Dark2") +
xlab("Brand Preference") +
ylab("Credit") +
ggtitle("Brand Preference v Credit")
g7 <- ggplotly(g7)
g7- There is no noteworthy pattern between brand preference and credit.
3.3 Initial Hypothesis
There is a general preference for brand 1 and salary seems the key feature.
Age and credit seem to have very limited influence on brand preference. Whilst there are patterns of preference within education level, car and zip code, salary appears to have the most striking impact.
Salaries ranging between 45k - 100k seem to have a preference for brand 0. Salaries outside of this range seem to have a preference for brand 1.
3.4 Feature Selection
3.4.1 Decision Tree Variable Importance
We can review the initial hypothesis and provide some information on which to make feature selection decisions using a decision tree.
featureDT <- rpart(brand ~ ., data = data)
featureDT$variable.importance## age salary car zipcode credit elevel
## 2036.06398 1421.30552 78.59978 42.70644 21.20404 16.06770fancyRpartPlot(featureDT)
The decision tree is formed exclusively of age and salary, suggesting these are the key features. This is reinfoced by the variable importance information from within the model.
3.4.2 Supplementary Exploratory Data Analysis
g12 <- ggplot(data, aes(salary, age, colour = brand)) +
geom_smooth() +
facet_grid(brand ~ .) +
theme_bw() +
scale_color_brewer(palette="Dark2") +
xlab("Salary") +
ylab("Age") +
ggtitle("Salary v Age by Brand Preference")
g12## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
3.4.3 Colinearity and Variance
##Review correlation matrix
corrMatrix <- origdata %>% cor()
corrMatrix %>% corrplot.mixed()
Reviewing the correlation plot we see very little correlation between the features. This means that colinearity is not an issue that needs to be addressed.
#near zero variance
nzv <- data %>% nearZeroVar(saveMetrics = TRUE)
nzv## freqRatio percentUnique zeroVar nzv
## salary 1.112069 97.53 FALSE FALSE
## age 1.178744 0.61 FALSE FALSE
## elevel 1.035946 0.05 FALSE FALSE
## car 1.026415 0.20 FALSE FALSE
## zipcode 1.020105 0.09 FALSE FALSE
## credit 1.057377 97.51 FALSE FALSE
## brand 1.643405 0.02 FALSE FALSEThere are no features with near zero variance.
3.4.4 Feature Selection Conclusion
4 Modelling
4.1 Modelling Preparation
#Creating Testing/Training sets
set.seed(111)
trainIndex <- createDataPartition(iris$Species, p = 0.75, list = FALSE)
training <- data[ trainIndex,]
testing <- data[-trainIndex,]
#set up parallel processing (requires parallel and doParallel libraries)
cluster <- makeCluster(detectCores() - 1) # convention to leave 1 core for OS
registerDoParallel(cluster)
#Cross Validation 10 fold
fitControl<- trainControl(method = "cv", number = 10, savePredictions = TRUE, allowParallel = TRUE)4.2 Modelling K-Nearest Neighbour
4.2.1 Data Transformations
Normalisation of data